home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue37 / Alfresco / ShowU1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-07-26  |  4.5 KB  |  186 lines
  1. unit ShowU1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls, VSortFns;
  8.  
  9. const
  10.   ElemCount = 300;
  11.  
  12. type
  13.   PSortArray = ^TSortArray;
  14.   TSortArray = array [0..pred(ElemCount)] of TSortElement;
  15.  
  16. type
  17.   TForm1 = class(TForm)
  18.     ButtonSort: TButton;
  19.     PaintBox1: TPaintBox;
  20.     ListBox1: TListBox;
  21.     ButtonRandomize: TButton;
  22.     ButtonReverse: TButton;
  23.     Memo1: TMemo;
  24.     ButtonAlmost: TButton;
  25.     Label1: TLabel;
  26.     procedure ButtonSortClick(Sender: TObject);
  27.     procedure PaintBox1Paint(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure FormDestroy(Sender: TObject);
  30.     procedure ButtonRandomizeClick(Sender: TObject);
  31.     procedure ButtonReverseClick(Sender: TObject);
  32.     procedure ButtonAlmostClick(Sender: TObject);
  33.   private
  34.     { Private declarations }
  35.   public
  36.     { Public declarations }
  37.     SA : PSortArray;
  38.     procedure ClearLabel;
  39.     procedure SetLabelToDone;
  40.   end;
  41.  
  42. var
  43.   Form1: TForm1;
  44.  
  45. implementation
  46.  
  47. {$R *.DFM}
  48.  
  49. procedure DrawLine(Canvas : TCanvas;
  50.                    Line   : integer;
  51.                    Len    : integer);
  52. begin
  53.   Canvas.MoveTo(3, Line + 1);
  54.   Canvas.LineTo(3+Len, Line + 1);
  55. end;
  56.  
  57. function LessAndShow(X, Y : TSortElement) : boolean; far;
  58. begin
  59.   Result := X < Y;
  60. end;
  61.  
  62. procedure SwapAndShow(var A : array of TSortElement;
  63.                           I, J : integer); far;
  64. var
  65.   Temp : TSortElement;
  66. begin
  67.   {paint out the current lines}
  68.   Form1.PaintBox1.Canvas.Pen.Color := clBtnFace;
  69.   DrawLine(Form1.PaintBox1.Canvas, I, A[I]);
  70.   DrawLine(Form1.PaintBox1.Canvas, J, A[J]);
  71.   Temp := A[I];
  72.   A[I] := A[J];
  73.   A[J] := Temp;
  74.   Form1.PaintBox1.Canvas.Pen.Color := clRed;
  75.   DrawLine(Form1.PaintBox1.Canvas, I, A[I]);
  76.   DrawLine(Form1.PaintBox1.Canvas, J, A[J]);
  77. end;
  78.  
  79. procedure SetAndShow(var A : array of TSortElement;
  80.                          X : TSortElement;
  81.                          I : integer); far;
  82. begin
  83.   Form1.PaintBox1.Canvas.Pen.Color := clBtnFace;
  84.   DrawLine(Form1.PaintBox1.Canvas, I, A[I]);
  85.   A[I] := X;
  86.   Form1.PaintBox1.Canvas.Pen.Color := clRed;
  87.   DrawLine(Form1.PaintBox1.Canvas, I, A[I]);
  88. end;
  89.  
  90. procedure TForm1.ButtonRandomizeClick(Sender: TObject);
  91. var
  92.   i : integer;
  93.   MaxLen : integer;
  94. begin
  95.   ClearLabel;
  96.   Randomize;
  97.   MaxLen := PaintBox1.Width-6;
  98.   for i := 0 to pred(ElemCount) do
  99.     SA^[i] := Random(MaxLen);
  100.   PaintBox1.Repaint;
  101. end;
  102.  
  103. procedure TForm1.ButtonSortClick(Sender: TObject);
  104. begin
  105.   ClearLabel;
  106.   case ListBox1.ItemIndex of
  107.     0 : VisualBubbleSort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow);
  108.     1 : VisualShakerSort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow);
  109.     2 : VisualSelectionSort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow);
  110.     3 : VisualInsertionSort(SA^, 0, pred(ElemCount), LessAndShow, SetAndShow);
  111.     4 : VisualBestInsertionSort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow, SetAndShow);
  112.     5 : VisualShellsort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow, SetAndShow);
  113.     6 : VisualQuicksort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow);
  114.     7 : VisualBestQuicksort(SA^, 0, pred(ElemCount), LessAndShow, SwapAndShow, SetAndShow);
  115.   end;
  116.   SetLabelToDone;
  117. end;
  118.  
  119. procedure TForm1.PaintBox1Paint(Sender: TObject);
  120. var
  121.   i : integer;
  122. begin
  123.   if SA <> nil then begin
  124.     PaintBox1.Canvas.Pen.Color := clRed;
  125.     for i := 0 to pred(ElemCount) do
  126.       DrawLine(PaintBox1.Canvas, i, SA^[i]);
  127.   end;
  128. end;
  129.  
  130. procedure TForm1.FormCreate(Sender: TObject);
  131. begin
  132.   New(SA);
  133.   ButtonRandomizeClick(Self);
  134.   ListBox1.ItemIndex := 0;
  135. end;
  136.  
  137. procedure TForm1.FormDestroy(Sender: TObject);
  138. begin
  139.   Dispose(SA);
  140.   SA := nil;
  141. end;
  142.  
  143. procedure TForm1.ButtonReverseClick(Sender: TObject);
  144. var
  145.   i : integer;
  146. begin
  147.   ClearLabel;
  148.   for i := 0 to pred(ElemCount) do
  149.     SA^[i] := ElemCount - i;
  150.   PaintBox1.Repaint;
  151. end;
  152.  
  153. procedure TForm1.ButtonAlmostClick(Sender: TObject);
  154. var
  155.   i : integer;
  156.   OtherInx : integer;
  157.   Temp : TSortElement;
  158. begin
  159.   ClearLabel;
  160.   Randomize;
  161.   for i := 0 to pred(ElemCount) do
  162.     SA^[i] := i;
  163.   for i := 0 to pred(ElemCount) do
  164.     if Random(100) < 5 then begin
  165.       OtherInx := Random(ElemCount);
  166.       Temp := SA^[i];
  167.       SA^[i] := SA^[OtherInx];
  168.       SA^[OtherInx] := Temp;
  169.     end;
  170.   PaintBox1.Repaint;
  171. end;
  172.  
  173. procedure TForm1.ClearLabel;
  174. begin
  175.   Label1.Caption := '';
  176.   Label1.Update;
  177. end;
  178.  
  179. procedure TForm1.SetLabelToDone;
  180. begin
  181.   Label1.Caption := 'Done!';
  182.   Label1.Update;
  183. end;
  184.  
  185. end.
  186.